﻿#VisualFreeBasic_Form#  Version=5.2.10
Locked=0

[Form]
Name=Form1
ClassStyle=CS_DBLCLKS,CS_HREDRAW,CS_VREDRAW
ClassName=
WinStyle=WS_CAPTION,WS_CLIPCHILDREN,WS_CLIPSIBLINGS,WS_MAXIMIZEBOX,WS_MINIMIZEBOX,WS_SYSMENU,WS_THICKFRAME,WS_VISIBLE,WS_EX_CONTROLPARENT,WS_EX_LEFT,WS_EX_LTRREADING,WS_EX_RIGHTSCROLLBAR,WS_EX_WINDOWEDGE,WS_POPUP,WS_SIZEBOX
Style=3 - 常规窗口
Icon=
Caption=通用API拦截例题
StartPosition=1 - 屏幕中心
WindowState=0 - 正常
Enabled=True
Repeat=False
Left=0
Top=0
Width=420
Height=434
TopMost=False
Child=False
MdiChild=False
TitleBar=True
SizeBox=True
SysMenu=True
MaximizeBox=True
MinimizeBox=True
Help=False
Hscroll=False
Vscroll=False
MinWidth=0
MinHeight=0
MaxWidth=0
MaxHeight=0
NoActivate=False
MousePass=False
TransPer=0
TransColor=SYS,25
BackColor=SYS,15
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
AcceptFiles=False

[Label]
Name=Label1
Index=-1
Style=0 - 无边框
Caption=把API替换为自己写的函数，实现 hook API（API拦截）
Enabled=True
Visible=True
ForeColor=SYS,8
BackColor=SYS,25
Font=微软雅黑,9
TextAlign=0 - 左对齐
Prefix=True
Ellipsis=False
Left=16
Top=10
Width=369
Height=17
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
ToolTip=
ToolTipBalloon=False

[Label]
Name=Label2
Index=-1
Style=0 - 无边框
Caption=这里是标准API替换（对绝大多数API有效果），非标准无法替换。
Enabled=True
Visible=True
ForeColor=SYS,8
BackColor=SYS,25
Font=微软雅黑,9
TextAlign=0 - 左对齐
Prefix=True
Ellipsis=False
Left=15
Top=33
Width=356
Height=17
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
ToolTip=
ToolTipBalloon=False

[Label]
Name=Label3
Index=-1
Style=0 - 无边框
Caption=变速倍数：1
Enabled=True
Visible=True
ForeColor=SYS,8
BackColor=SYS,25
Font=微软雅黑,9
TextAlign=0 - 左对齐
Prefix=True
Ellipsis=False
Left=38
Top=136
Width=83
Height=18
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
ToolTip=
ToolTipBalloon=False

[Frame]
Name=Frame1
Index=-1
Caption=变速齿轮例题 timeGetTime（启用后不可撤销）
TextAlign=0 - 左对齐
Fillet=5
BorderWidth=1
BorderColor=SYS,16
ForeColor=SYS,8
BackColor=SYS,25
Enabled=True
Visible=True
Font=微软雅黑,9
Left=18
Top=64
Width=371
Height=105
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
ToolTip=
ToolTipBalloon=False

[Label]
Name=Label4
Index=0
Style=0 - 无边框
Caption=原速数值：1
Enabled=True
Visible=True
ForeColor=SYS,8
BackColor=SYS,25
Font=微软雅黑,9
TextAlign=0 - 左对齐
Prefix=True
Ellipsis=False
Left=79
Top=88
Width=178
Height=18
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
ToolTip=
ToolTipBalloon=False

[Label]
Name=Label4
Index=1
Style=0 - 无边框
Caption=变速数值：1
Enabled=True
Visible=True
ForeColor=SYS,8
BackColor=SYS,25
Font=微软雅黑,9
TextAlign=0 - 左对齐
Prefix=True
Ellipsis=False
Left=79
Top=112
Width=178
Height=16
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
ToolTip=
ToolTipBalloon=False

[Hscroll]
Name=HScroll1
Index=-1
Max=9
Min=1
Value=4
Page=0
SmallChange=1
LargeChange=2
Enabled=True
Visible=True
Left=136
Top=139
Width=233
Height=19
ALING=False
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
AcceptFiles=False

[Button]
Name=Command1
Index=-1
Caption=测试Hook111222
Enabled=True
Visible=True
Default=False
OwnDraw=False
MultiLine=False
Font=微软雅黑,9
Left=285
Top=312
Width=95
Height=26
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False

[TextBox]
Name=Text1
Index=-1
Style=3 - 凹边框
TextScrollBars=0 - 无滚动条
Text=&H7516E909
Enabled=True
Visible=True
MaxLength=0
ForeColor=SYS,8
BackColor=SYS,5
Font=微软雅黑,9
TextAlign=0 - 左对齐
PasswordChar=
Locked=False
HideSelection=True
Multiline=False
Uppercase=False
Lowercase=False
Number=False
AutoHScroll=True
AutoVScroll=False
Left=107
Top=315
Width=167
Height=21
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
LeftMargin=0
RightMargin=0
AcceptFiles=False

[Label]
Name=Label5
Index=-1
Style=0 - 无边框
Caption=变速倍数：1
Enabled=True
Visible=True
ForeColor=SYS,8
BackColor=SYS,25
Font=微软雅黑,9
TextAlign=0 - 左对齐
Prefix=True
Ellipsis=False
Left=39
Top=256
Width=83
Height=18
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
ToolTip=
ToolTipBalloon=False

[Frame]
Name=Frame2
Index=-1
Caption=变速齿轮例题 GetTickCount（启用后不可撤销）
TextAlign=0 - 左对齐
Fillet=5
BorderWidth=1
BorderColor=SYS,16
ForeColor=SYS,8
BackColor=SYS,25
Enabled=True
Visible=True
Font=微软雅黑,9
Left=18
Top=184
Width=371
Height=105
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
ToolTip=
ToolTipBalloon=False

[Label]
Name=Label6
Index=0
Style=0 - 无边框
Caption=原速数值：1
Enabled=True
Visible=True
ForeColor=SYS,8
BackColor=SYS,25
Font=微软雅黑,9
TextAlign=0 - 左对齐
Prefix=True
Ellipsis=False
Left=80
Top=208
Width=178
Height=18
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
ToolTip=
ToolTipBalloon=False

[Label]
Name=Label6
Index=1
Style=0 - 无边框
Caption=变速数值：1
Enabled=True
Visible=True
ForeColor=SYS,8
BackColor=SYS,25
Font=微软雅黑,9
TextAlign=0 - 左对齐
Prefix=True
Ellipsis=False
Left=80
Top=232
Width=178
Height=16
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
ToolTip=
ToolTipBalloon=False

[Hscroll]
Name=HScroll2
Index=-1
Max=9
Min=1
Value=4
Page=0
SmallChange=1
LargeChange=2
Enabled=True
Visible=True
Left=137
Top=259
Width=233
Height=19
ALING=False
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
AcceptFiles=False

[Label]
Name=Label7
Index=-1
Style=0 - 无边框
Caption=函数头地址：
Enabled=True
Visible=True
ForeColor=SYS,8
BackColor=SYS,25
Font=微软雅黑,9
TextAlign=0 - 左对齐
Prefix=True
Ellipsis=False
Left=20
Top=316
Width=87
Height=19
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
ToolTip=
ToolTipBalloon=False

[Label]
Name=Label8
Index=-1
Style=0 - 无边框
Caption=被测试函数不可使用，一使用就会崩溃。地址出错也会崩溃。
Enabled=True
Visible=True
ForeColor=SYS,8
BackColor=SYS,25
Font=微软雅黑,9
TextAlign=0 - 左对齐
Prefix=True
Ellipsis=False
Left=14
Top=343
Width=329
Height=21
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
ToolTip=
ToolTipBalloon=False

[Button]
Name=Command2
Index=-1
Caption=开启
Enabled=True
Visible=True
Default=False
OwnDraw=False
MultiLine=False
Font=微软雅黑,9
Left=336
Top=200
Width=48
Height=26
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False

[Button]
Name=Command3
Index=-1
Caption=开启
Enabled=True
Visible=True
Default=False
OwnDraw=False
MultiLine=False
Font=微软雅黑,9
Left=337
Top=76
Width=48
Height=26
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False

[Button]
Name=Command4
Index=-1
Caption=执行
Enabled=True
Visible=True
Default=False
OwnDraw=False
MultiLine=False
Font=微软雅黑,9
Left=343
Top=350
Width=46
Height=37
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False

[Label]
Name=Label9
Index=-1
Style=0 - 无边框
Caption=点击【执行】看效果，然后点【测试Hook】再点执行试试
Enabled=True
Visible=True
ForeColor=SYS,8
BackColor=SYS,25
Font=微软雅黑,9
TextAlign=0 - 左对齐
Prefix=True
Ellipsis=False
Left=16
Top=367
Width=329
Height=21
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
ToolTip=
ToolTipBalloon=False


[AllCode]
#Include Once "win\mmsystem.bi"  
Dim Shared PtimeGetTime As Function() As ULong  '定义一个没被变速原API，供自己使用。
Dim Shared PGetTickCount As Function() As ULong  '定义一个没被变速原API，供自己使用。
Dim Shared sudu As Single  '变速值
Dim Shared sudu2 As Single  '变速值
Sub Form1_Shown(hWndForm As hWnd, UserData As Integer)  '窗口完全显示后。UserData 来自显示窗口最后1个参数。
    Text1.Text ="&H" & Hex(@MyFunction2)

End Sub

Function otimeGetTime() As ULong   '改写timeGetTime 实现变速功能，
   Static As Long 上次返回时间 ,上次正常时间
   Dim Result As ULong 
   if sudu = 0 Then sudu = 1
   if 上次返回时间 = 0 Then 上次返回时间 = PtimeGetTime()
   if 上次正常时间 = 0 Then 上次正常时间 = PtimeGetTime()
   
   上次返回时间 += (PtimeGetTime() - 上次正常时间) * sudu
   上次正常时间 = PtimeGetTime()
   Function= 上次返回时间
  
End Function
Function oGetTickCount() As ULong   '改写GetTickCount 实现变速功能
   Static As Long 上次返回时间 ,上次正常时间
   Dim Result As ULong 
   if sudu2 = 0 Then sudu2 = 1
   if 上次返回时间 = 0 Then 上次返回时间 = PGetTickCount()
   if 上次正常时间 = 0 Then 上次正常时间 = PGetTickCount()
   
   上次返回时间 += (PGetTickCount() - 上次正常时间) * sudu2
   上次正常时间 = PGetTickCount()
   Function= 上次返回时间
  
End Function
'hook API（拦截API，把API函数替换为自己写的函数）
'nAPI   API 函数指针
'nFun   自己写的函数指针
'返回  0 成功，非0 失败 
'Function hook_API(nAPI As Any Ptr, nFun As Any Ptr) As Long
'   '先测试是不是标准API,标准API的地址 数据是：8B FF
'   PrintA Hex(nAPI), *CPtr(Long Ptr, Cast(UInteger, nAPI) -5),*CPtr(Long Ptr, Cast(UInteger, nAPI) -2)
'   if *CPtr(UShort Ptr, nAPI) = 65419 Then  '8B FF
'      Dim by(6) As UByte
'      by(5) = &HEB : by(6) = &HF9  '修改API头
'      by(0) = &HE9
'      Dim n As UInteger = Cast(UInteger, nAPI) - Cast(UInteger, nAPI) -5  '计算跳转到我们自己函数公式
'      Poke UInteger, @by(1), n  '写入by 准备好内容
'      if MEM_Write(GetCurrentProcessId, Cast(UInteger, nAPI) -5, @by(0), 7) Then '因为代码是非读写区，必须用API写内存。
'         Return 0
'      Else    
'         Return 2
'      end if 
'   Else
'      Return 1
'   End if
'End Function

Sub 原速数值(a As Long)
   Dim tt As ULong = PtimeGetTime()
   Dim ss As ULong 
   Do
      if PtimeGetTime() - tt > 100 Then 
         tt = PtimeGetTime()
         ss += 1
         Label4(0).Caption = "原速数值：" & Format(ss/10,"0.0")
      End if 
      Sleep 10
   Loop    
End Sub
Sub 变速数值(a As Long )
   Dim tt As ULong = timeGetTime()
   Dim ss As ULong 
   Do
      if timeGetTime() - tt > 100 Then 
         tt = timeGetTime()
         ss += 1
         Label4(1).Caption = "变速数值：" & Format(ss/10,"0.0")
      End if 
      Sleep 10
   Loop  
End Sub
Sub 原速数值2(a As Long)
   Dim tt As ULong = PGetTickCount()
   Dim ss As ULong 
   Do
      if PGetTickCount() - tt > 100 Then 
         tt = PGetTickCount()
         ss += 1
         Label6(0).Caption = "原速数值：" & Format(ss/10,"0.0")
      End if 
      Sleep 10
   Loop    
End Sub
Sub 变速数值2(a As Long )
   Dim tt As ULong = GetTickCount()
   Dim ss As ULong 
   Do
      if GetTickCount() - tt > 100 Then 
         tt = GetTickCount()
         ss += 1
         Label6(1).Caption = "变速数值：" & Format(ss/10,"0.0")
      End if 
      Sleep 10
   Loop  
End Sub
Sub Form1_HScroll1_Change(hWndForm As hWnd, hWndControl As hWnd, hNewPos As Long, nScrollCode As Long )  '左右滚动条的值发生了改变
   'nScrollCode = SB_LINELEFT  SB_LINERIGHT  SB_PAGELEFT  SB_PAGERIGHT  SB_THUMBPOSITION SB_THUMBTRACK  SB_ENDSCROLL   SB_LEFT     SB_RIGHT  
   ''             点击向左按钮 点击向右按钮  点击滑块左边 点击滑块右边  托动滑块结束     托动滑块进行中 结束滚动条操作 滚动到左边  滚动到右边
   'hNewPos       滑块位置（注意：因为操作系统传来是16位数，最大为65535）
   Select Case hNewPos
      Case 1 :sudu = 0.4
      Case 2 :sudu = 0.6
      Case 3 :sudu = 0.8
      Case 4 :sudu = 1
      Case 5 :sudu = 2
      Case 6 :sudu = 4
      Case 7 :sudu = 8
      Case 8 :sudu = 16
      Case 9 :sudu = 32
   End Select          
   Label3.Caption ="变速倍数：" & sudu 
End Sub
Sub Form1_HScroll2_Change(hWndForm As hWnd, hWndControl As hWnd, hNewPos As Long, nScrollCode As Long )  '左右滚动条的值发生了改变
   'nScrollCode = SB_LINELEFT  SB_LINERIGHT  SB_PAGELEFT  SB_PAGERIGHT  SB_THUMBPOSITION SB_THUMBTRACK  SB_ENDSCROLL   SB_LEFT     SB_RIGHT  
   ''             点击向左按钮 点击向右按钮  点击滑块左边 点击滑块右边  托动滑块结束     托动滑块进行中 结束滚动条操作 滚动到左边  滚动到右边
   'hNewPos       滑块位置（注意：因为操作系统传来是16位数，最大为65535）
       Select Case hNewPos
      Case 1 :sudu2 = 0.4
      Case 2 :sudu2 = 0.6
      Case 3 :sudu2 = 0.8
      Case 4 :sudu2 = 1
      Case 5 :sudu2 = 2
      Case 6 :sudu2 = 4
      Case 7 :sudu2 = 8
      Case 8 :sudu2 = 16
      Case 9 :sudu2 = 32
   End Select          
   Label5.Caption ="变速倍数：" & sudu2      
End Sub

Sub Form1_Command2_BN_Clicked(hWndForm As hWnd, hWndControl As hWnd)  '单击
   Command2.Enabled =False 
   Dim  t As Any Ptr  =  Hook_API("kernel32", "GetTickCount", @oGetTickCount) 
   if t Then 
      PGetTickCount = t '标准API特性
      Threaddetach ThreadCreate(Cast(Any Ptr, @原速数值2), 0) '经典调用方法
      Threaddetach ThreadCreate(Cast(Any Ptr, @变速数值2), 0) '经典调用方法
      PrintA Hex(t),Hex(@oGetTickCount)
   Else 
      AfxMsg "替换API失败"
      End
   End if
End Sub

Sub Form1_Command3_BN_Clicked(hWndForm As hWnd, hWndControl As hWnd)  '单击
   Command3.Enabled=False 
     Dim t As Any Ptr
  t = Hook_API("winmm", "timeGetTime", @otimeGetTime) 
   if t Then 
      PtimeGetTime = t '标准API特性
      Threaddetach ThreadCreate(Cast(Any Ptr, @原速数值), 0) '经典调用方法
      Threaddetach ThreadCreate(Cast(Any Ptr, @变速数值), 0) '经典调用方法
      PrintA Hex(t),Hex(@otimeGetTime)
   Else 
      AfxMsg "替换API失败"
      End
   End if
End Sub





Sub Form1_Command1_BN_Clicked(hWndForm As hWnd, hWndControl As hWnd)  '单击
   
   if Command1.Caption = "撤销Hook" Then
      Dim t As UInteger = ValUInt("&H" & Command1.Tag)
      if UnHook_API( Cast(Any Ptr,t )) Then AfxMsg "撤销Hook成功" Else  AfxMsg "撤销Hook失败"
      Command1.Caption = "测试Hook"
   Else
      Dim t As UInteger = ValULng(Text1.Text)
      if t Then
         Command1.Tag = Hex(Hook_FuncAddr(cast(Any Ptr, t), @MyFunction))
         Command1.Caption = "撤销Hook"
         PrintA Command1.Tag ,Hex(@MyFunction)
         if Val(Command1.Tag) Then   AfxMsg "Hook成功" Else  AfxMsg "Hook失败"
      End if
   End if
End Sub

Function MyFunction() As Long                        
   '被测试函数，一用就会崩溃，因为这里没有写被测试函数的 参数。要正常测试，这里写被测试函数的正确参数。
   AfxMsg "我是被替换后的函数"
Function =0 
End Function

Function MyFunction2() As Long 
  AfxMsg "我是正常函数" 
Function =0 
End Function

Sub Form1_Command4_BN_Clicked(hWndForm As hWnd, hWndControl As hWnd)  '单击
MyFunction2
End Sub













